home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_2 / scrlfqot.zip / SCRLFQOT.LST < prev    next >
File List  |  1991-09-06  |  14KB  |  266 lines
  1.                                                                         PAGE   1
  2.                                                                        09-06-91
  3.                                                                        17:59:06
  4.  
  5.  Line#  Source Line          Microsoft FORTRAN Optimizing Compiler Version 5.00
  6.  
  7.      1  C *********************************************************************
  8.      2  C *** This is a typical comment line.  `!' denotes comment following  *
  9.      3  C *** a FORTRAN statement.                                            *
  10.      4  C ***                                                                 *
  11.      5  C *** M/L Routine to build ALTERNATE Simplex quote.cq file using      *
  12.      6  C *** CR+LF, CR+LF delineators.  A quote line is defined as           *
  13.      7  C *** anything in between.                                            *
  14.      8  C ***                                                                 *
  15.      9  C *** This was written in FORTRAN to prove it can be done!            *
  16.     10  C ***                                                                 *
  17.     11  C ***    'SAMPLE'C   implies C null terminated string.                *
  18.     12  C *********************************************************************
  19.     13  
  20.     14  C *** Default first letter variable type:
  21.     15        IMPLICIT INTEGER*4 (a-z)
  22.     16  
  23.     17  C *** Default over-rides:
  24.     18        CHARACTER*32   infile, outfile          ! I/O pathspecs.
  25.     19        CHARACTER*4    qt_scan, test$           ! For 2 newline search.
  26.     20        CHARACTER*1    qt_scan_1 (4), temp$     ! For scanning text file.
  27.     21        CHARACTER*14   chris_stuff              ! Validity check.
  28.     22        CHARACTER*5    r_tab                    ! Backspaces for screen.
  29.     23  
  30.     24        INTEGER *2 status, qt_num
  31.     25  
  32.     26        LOGICAL test
  33.     27  
  34.     28        DIMENSION    qt_loc (4096)              ! Space internal in EXE.
  35.     29        EQUIVALENCE  ( qt_scan, qt_scan_1(1) )  ! Common RAM space.
  36.     30  
  37.     31  C *** `chris_stuff' is Laforet's null terminated validity check.
  38.     32  C *** `test$' is 2 newlines, or CR+LF+CR+LF.
  39.     33  C *** `qt_scan' is initialized to avoid an undefined variable.
  40.     34  C *** `r_tab' is a series of backspaces.
  41.     35        chris_stuff= 'Simplex Quote'C
  42.     36        test$=  CHAR(13) // CHAR(10) // CHAR(13) // CHAR(10)
  43.     37        qt_scan= '    '
  44.     38        r_tab= CHAR(8) // CHAR(8) // CHAR(8) // CHAR(8) // CHAR(8)
  45.     39  
  46.     40        PRINT *
  47.     41        PRINT *,' S_CR_LF_QOT version 1.02,   (c) 1991 Fred Niemczenia.'
  48.     42        PRINT *,' Alternate quote file generator for Simplex BBS, which'
  49.     43        PRINT *,' is the copyrighted brainchild of Chris Laforet.'
  50.     44        PRINT *,'    *** You may use this utility without charge. ***'
  51.     45        PRINT *
  52.     46  
  53.     47  C *** PARSE command line.
  54.     48        numargs= NARGS ()
  55.     49  C *** MS-FORTRAN ver 5.0 compiler ERROR documented.  NARGS returns
  56.     50  C *** 1 as a minimum value when there is no argument.  Documentation
  57.     51  C *** implies 0 in section 5.3.3 of reference manual.
  58.     52        IF  (numargs .LE. 1)  GOTO 9990
  59.     53        CALL GETARG (1, infile, status)
  60.     54  
  61.     55  C *** Test if infile exists. If not, exit!
  62.     56        INQUIRE (FILE= infile, EXIST= test)
  63.     57          IF  ( .NOT. test )  THEN
  64.     58             PRINT *, ' I couldn''t find: ', infile
  65.                                                                         PAGE   2
  66.                                                                        09-06-91
  67.                                                                        17:59:06
  68.  
  69.  Line#  Source Line          Microsoft FORTRAN Optimizing Compiler Version 5.00
  70.  
  71.     59             PRINT *, ' Run me again and get it right this time!'
  72.     60             PRINT *
  73.     61             GOTO 9990
  74.     62          END IF
  75.     63  
  76.     64        len1= INDEX (infile, '.q ')             ! Both CAPS & Lower
  77.     65        len2= INDEX (infile, '.Q ')             ! case.
  78.     66  
  79.     67        IF  ( len1 .EQ. 0  .AND.  len2 .EQ. 0 )  THEN
  80.     68            PRINT *, infile, 'is an invalid name!'
  81.     69            PRINT *
  82.     70            GOTO 9990
  83.     71          ELSE IF  ( len1 .GT. len2 )  THEN     ! len? includes `.'
  84.     72            length= len1                        ! For lower case.
  85.     73          ELSE
  86.     74            length= len2                        ! For upper case.
  87.     75        END IF
  88.     76  
  89.     77        outfile= infile(1:length)  //  'cq'     ! Concatenate ext.
  90.     78  
  91.     79  C *********************************************************************
  92.     80  C *** So let's check for how many separate quotations there are.      *
  93.     81  C *** NOTE:                                                           *
  94.     82  C ***  (1) It is understood that each text file has actual text on    *
  95.     83  C ***      the first line.  You can't start with a blank line.        *
  96.     84  C ***  (2) There can be more than one line per quote.  SQUOTE assumes *
  97.     85  C ***      ONE quote per line.  SCRLFQOT does not!  Most text editors *
  98.     86  C ***      set a limit on line length, hence this program.            *
  99.     87  C ***  (3) Separate quotes are separated by a blank line. This implies*
  100.     88  C ***      a CR+LF+CR+LF between quotes.  Only ONE blank line is      *
  101.     89  C ***      allowed between quotes ( aka 2 newlines).                  *
  102.     90  C ***  (4) The last line of the file MUST be a blank line.            *
  103.     91  C *********************************************************************
  104.     92  
  105.     93        OPEN (UNIT=10, FILE= infile, FORM= 'BINARY', ACCESS='SEQUENTIAL',
  106.     94       &  STATUS= 'UNKNOWN')
  107.     95  
  108.     96  C *********************************************************************
  109.     97  C ***   First processing LOOP begins!  Scan for CR+LF+CR+LF           *
  110.     98  C *********************************************************************
  111.     99        qt_num=    1                            ! Initialize qt counter.
  112.    100        i_rec=     0                            ! Initialize pointer.
  113.    101        qt_loc(1)= 0                            ! First pointer loc.
  114.    102        PRINT 9002                              ! Processing Quote
  115.    103  
  116.    104        DO WHILE  ( .NOT. EOF(10) )
  117.    105           i_rec= i_rec + 1                     ! Increment pointer.
  118.    106           qt_scan_1(1)= qt_scan_1(2)           ! Byte shift left.
  119.    107           qt_scan_1(2)= qt_scan_1(3)           ! Byte shift left.
  120.    108           qt_scan_1(3)= qt_scan_1(4)           ! Byte shift left.
  121.    109           READ (10)  qt_scan_1(4)              ! Input a byte.
  122.    110           IF  ( qt_scan .EQ. test$ )  THEN     ! Remember common RAM.
  123.    111              qt_num= qt_num + 1                ! Increment qt counter.
  124.    112              qt_loc(qt_num)= i_rec             ! Store raw pointer.
  125.    113              PRINT 9003, r_tab, qt_num-1
  126.    114           END IF
  127.    115        END DO
  128.    116  
  129.                                                                         PAGE   3
  130.                                                                        09-06-91
  131.                                                                        17:59:06
  132.  
  133.  Line#  Source Line          Microsoft FORTRAN Optimizing Compiler Version 5.00
  134.  
  135.    117        CLOSE (10)                              ! Close the infile.
  136.    118        qt_num= qt_num - 1                      ! Adj. end overcount.
  137.    119  C     PRINT 9001, (qt_loc(i), i=1, qt_num)    ! Debugging only!
  138.    120  
  139.    121  C *********************************************************************
  140.    122  C ***        First processing loop ends & second begins!              *
  141.    123  C *********************************************************************
  142.    124  
  143.    125        OPEN (UNIT=10, FILE= infile, FORM= 'BINARY', ACCESS='SEQUENTIAL',
  144.    126       &  STATUS= 'UNKNOWN')
  145.    127  
  146.    128        OPEN (UNIT=11, FILE=outfile, FORM= 'BINARY', ACCESS='SEQUENTIAL',
  147.    129       &  STATUS= 'UNKNOWN')
  148.    130  
  149.    131        PRINT *
  150.    132        PRINT *, ' Writing Header block: ', outfile
  151.    133  
  152.    134  C *** Write the validity check & quote counter.
  153.    135        WRITE (11)  chris_stuff, qt_num         ! 14 bytes + 2 bytes.
  154.    136  C *** Calculate and write the pointers.
  155.    137        offset= 16 + (qt_num * 4)               ! For header block.
  156.    138        DO  2000  i= 1, qt_num                  ! Begin loop.
  157.    139          pointer= qt_loc(i) +offset -(i-1) * 3 ! -4 +1 byte for 2
  158.    140          WRITE (11) pointer                    ! newlines & \0.
  159.    141  2000  CONTINUE                                ! End of Loop.
  160.    142  
  161.    143        PRINT 9004                              ! Writing Quote
  162.    144        DO  3000  i=1, qt_num + 1               ! Loop for each quote.
  163.    145        PRINT 9003, r_tab, i-1
  164.    146          DO  2500  j= qt_loc(i), qt_loc(i+1)-5 ! Loop within quote.
  165.    147            READ (10, END=2800) temp$           ! Process byte by byte.
  166.    148            WRITE (11) temp$
  167.    149  2500    CONTINUE
  168.    150          DO  2700  j= 1, 4
  169.    151            READ (10, END=2800,ERR=8000) temp$  ! Pass over 2 newlines.
  170.    152  2700    CONTINUE
  171.    153  2800    WRITE (11) ''C                        ! Append \0 (null).
  172.    154  3000  CONTINUE
  173.    155  
  174.    156        CLOSE (10)
  175.    157        CLOSE (11)
  176.    158  
  177.    159  C *********************************************************************
  178.    160  C ***        Second processing loop ends!                             *
  179.    161  C *********************************************************************
  180.    162  
  181.    163        PRINT *
  182.    164        PRINT *, ' Ho-Hum, I''m done!'
  183.    165        GOTO 9999
  184.    166  
  185.    167  8000  PRINT *
  186.    168        PRINT *, ' An attempt to read past the end of the input file'
  187.    169        PRINT *, ' has occurred.  The Probable cause is:'
  188.    170        PRINT *, '  (1) The first line does not contain text.'
  189.    171        PRINT *, '  (2) Quotes are separated by MORE than ONE blank'
  190.    172        PRINT *, '      line.'
  191.    173        PRINT *, '  (3) The file doesn''t end with ONE blank line.'
  192.    174        PRINT *, ' Please recheck your quote file.'
  193.                                                                         PAGE   4
  194.                                                                        09-06-91
  195.                                                                        17:59:06
  196.  
  197.  Line#  Source Line          Microsoft FORTRAN Optimizing Compiler Version 5.00
  198.  
  199.    175        GOTO 9999
  200.    176  
  201.    177  9990  PRINT *, ' SCRLFQOT expects a command line agrument.  Consider'
  202.    178        PRINT *, ' the following example:'
  203.    179        PRINT *
  204.    180        PRINT *, ' SCRLFQOT sample.q {ENTER}'
  205.    181        PRINT *
  206.    182        PRINT *, ' The argument must be a valid file in the current'
  207.    183        PRINT *, ' directory, and MUST have the extension "q".  The'
  208.    184        PRINT *, ' routine will generate  sample.cq  in the current'
  209.    185        PRINT *, ' directory.'
  210.    186  9999  CONTINUE
  211.    187  
  212.    188  9001  FORMAT (8(1X,Z8))
  213.    189  9002  FORMAT (1X,' Finding Quote:      '\)
  214.    190  9003  FORMAT (A5,I5\)
  215.    191  9004  FORMAT (1X,' Writing Quote:      '\)
  216.    192  
  217.    193        END
  218.  
  219.  
  220. main  Local Symbols
  221.  
  222. Name                      Class   Type              Size   Offset  
  223.  
  224. TEST. . . . . . . . . . . local   LOGICAL*4            4    0006
  225. I_REC . . . . . . . . . . local   INTEGER*4            4    000a
  226. LENGTH. . . . . . . . . . local   INTEGER*4            4    000e
  227. OFFSET. . . . . . . . . . local   INTEGER*4            4    0012
  228. R_TAB . . . . . . . . . . local   CHAR*5               5    0016
  229. I . . . . . . . . . . . . local   INTEGER*4            4    001c
  230. J . . . . . . . . . . . . local   INTEGER*4            4    0020
  231. LEN1. . . . . . . . . . . local   INTEGER*4            4    0024
  232. LEN2. . . . . . . . . . . local   INTEGER*4            4    0028
  233. OUTFILE . . . . . . . . . local   CHAR*32             32    002c
  234. TEMP$ . . . . . . . . . . local   CHAR*1               1    004c
  235. NUMARGS . . . . . . . . . local   INTEGER*4            4    004e
  236. CHRIS_STUFF . . . . . . . local   CHAR*14             14    0052
  237. POINTER . . . . . . . . . local   INTEGER*4            4    0060
  238. QT_LOC. . . . . . . . . . local   INTEGER*4        16384    0064
  239. STATUS. . . . . . . . . . local   INTEGER*2            2    4064
  240. TEST$ . . . . . . . . . . local   CHAR*4               4    4066
  241. QT_NUM. . . . . . . . . . local   INTEGER*2            2    406a
  242. INFILE. . . . . . . . . . local   CHAR*32             32    406c
  243. QT_SCAN . . . . . . . . . local   CHAR*4               4    0002
  244. QT_SCAN_1 . . . . . . . . local   CHAR*1               4    0002
  245.  
  246.  
  247. Global Symbols
  248.  
  249. Name                      Class   Type              Size   Offset  
  250.  
  251. GETARG. . . . . . . . . . extern  ***                ***     ***
  252. NARGS . . . . . . . . . . extern  INTEGER*4          ***     ***
  253. main. . . . . . . . . . . FSUBRT  ***                ***    0000
  254.  
  255. Code size = 05e9 (1513)
  256. Data size = 050f (1295)
  257.                                                                         PAGE   5
  258.                                                                        09-06-91
  259.                                                                        17:59:06
  260.  
  261.                              Microsoft FORTRAN Optimizing Compiler Version 5.00
  262.  
  263. Bss size  = 408c (16524)
  264.  
  265. No errors detected
  266.